(in-package :gwee)

(defvar *input-default-history* nil
  "Default variable to store input history.")

(defvar *input-current-key* nil)

(defun default-keymap ()
  (keymap "C-a" 'beginning-of-line
          "C-e" 'end-of-line
          "C-f" 'forward-char
          "C-b" 'backward-char
          "C-k" 'kill-line
          "left" 'backward-char
          "right" 'forward-char
          "up" 'history-backward
          "down" 'history-forward
          "backspace" 'backward-delete-char
          t 'self-insert))

(defclass text-input (widget data-mixin foreground-mixin background-mixin margin-mixin)
  ((cursor :initform 0 :accessor text-input-cursor)
   (history-variable :initform '*input-default-history* :initarg :history :accessor text-input-history)
   (keymap :initform (default-keymap) :initarg :keymap :accessor text-input-keymap))
  (:default-initargs
   :border-color (gray 255)
   :data ""))

(defmethod draw-view ((view text-input))
  (with-slots (data cursor font) view
    (cond
      ((zerop (length data))
       (unless (disabled-p view)
         (sdl:draw-box-* (+ (view-cache-top-x view) (margin-left view))
                         (+ (view-cache-top-y view) (margin-top view))
                         (sdl:get-font-size "s" :size :w :font font)
                         (sdl:get-font-height :font (view-font view))
                         :color (foreground-color view))))
      ((>= cursor
           (length data))
       (let ((len (sdl:get-font-size data :size :w :font font)))
         ;;(print (list (view-cache-top-x view) (view-cache-top-y view)))
         (sdl:draw-string-blended-* data
                                    (+ (view-cache-top-x view) (margin-left view))
                                    (+ (view-cache-top-y view) (margin-top view))
                                    :font font
                                    :color (foreground-color view))
         (unless (disabled-p view)
           (sdl:draw-box-* (+ (view-cache-top-x view) (margin-left view) len)
                           (+ (view-cache-top-y view) (margin-top view))
                           (sdl:get-font-size "s" :size :w :font font)
                           (sdl:get-font-height :font (view-font view))
                           :color (foreground-color view)))))
      (t
       (let* ((before (subseq data 0 cursor))
              (before-len (sdl:get-font-size before :size :w :font font))
              (cursor-char (string (char data cursor)))
              (cursor-len (sdl:get-font-size cursor-char :size :w :font font))
              (after (subseq data (1+ cursor))))
         (when (> (length before) 0)
           (sdl:draw-string-blended-* before
                                      (+ (view-cache-top-x view) (margin-left view))
                                      (+ (view-cache-top-y view) (margin-top view))
                                      :font font
                                      :color (foreground-color view)))
    (unless (disabled-p view)
      (sdl:draw-string-shaded-* cursor-char
                                (+ (view-cache-top-x view) (margin-left view) before-len)
                                (+ (view-cache-top-y view) (margin-top view))
                                (background-color view)
                                (foreground-color view)
                                :font font))
         (when (> (length after) 0)
           (sdl:draw-string-blended-* after
                                      (+ before-len cursor-len (view-cache-top-x view) (margin-left view))
                                      (+ (view-cache-top-y view) (margin-top view))
                                      :font font
                                      :color (foreground-color view))))))))

(defun beginning-of-line (context)
  (setf (text-input-cursor context) 0
	(view-needs-update-p context) t))

(defun end-of-line (context)
  (setf (text-input-cursor context) (length (view-data context))
	(view-needs-update-p context) t))

(defun backward-char (context)
  (setf (text-input-cursor context) (max 0 (1- (text-input-cursor context)))
	(view-needs-update-p context) t))

(defun forward-char (context)
  (setf (text-input-cursor context) (min (length (view-data context)) (1+ (text-input-cursor context)))
	(view-needs-update-p context) t))

(defun kill-line (context)
  (when (< (text-input-cursor context) (length (view-data context)))
    (setf (view-data context) (subseq (view-data context) 0 (text-input-cursor context))
          (text-input-cursor context) (length (view-data context)))))

(defun history-backward (context)
  (setf (view-data context) "do history-forward"
	(view-needs-update-p context) t))

(defun history-forward (context)
  (setf (view-data context) "do history-forward"
	(view-needs-update-p context) t))

(defun backward-delete-char (context)
  (with-slots (cursor data) context
    (when (> cursor 0)
      (setf data (concatenate 'string
			      (subseq data 0 (1- cursor))
			      (subseq data cursor))
	    cursor (1- cursor)
	    (view-needs-update-p context) t))))

(defun self-insert (context)
  (when (and
         ;; some keys have characters but aren't letters.
         (not (find (key-sym *input-current-key*)
                    '(:sdl-key-tab :sdl-key-return :sdl-key-backspace
                      :sdl-key-kp-enter)))
         (or (null (key-mod *input-current-key*))
             (equal (key-mod *input-current-key*) '(:shift))))
    (with-slots (cursor data) context
      (let ((ch (key-to-character *input-current-key* )))
        (when ch
          (setf data (concatenate 'string
                                  (subseq data 0 cursor)
                                  (string ch)
                                  (subseq data cursor))
                cursor (1+ cursor)
                (view-needs-update-p context) t))))))

(defmethod key-press-event ((view text-input) key)
  (unless (disabled-p view)
  (let ((binding (find-binding (text-input-keymap view) key)))
;;     (print key)
    (when binding
      (let ((*input-current-key* key))
	(execute-key-action view (binding-action binding))
      )))))

;; (defmethod mouse-press-event ((view text-input) button x y)
;;   (

(defmethod (setf view-data) :after (value (view text-input))
  (setf (text-input-cursor view) (length value)))